home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / misc / sci / ephem_src_4_28.lha / compiler.c < prev    next >
C/C++ Source or Header  |  1992-04-17  |  16KB  |  581 lines
  1. /* module to compile and execute a c-style arithmetic expression.
  2.  * public entry points are compile_expr() and execute_expr().
  3.  *
  4.  * one reason this is so nice and tight is that all opcodes are the same size
  5.  * (an int) and the tokens the parser returns are directly usable as opcodes,
  6.  * for the most part. constants and variables are compiled as an opcode
  7.  * with an offset into the auxiliary opcode tape, opx.
  8.  */
  9.  
  10. #include <math.h>
  11. #include <ctype.h>
  12. #ifdef VMS
  13. #include <stdlib.h>
  14. #endif
  15. #include "screen.h"
  16.  
  17. /* parser tokens and opcodes, as necessary */
  18. #define    HALT    0    /* good value for HALT since program is inited to 0 */
  19. /* binary operators (precedences in table, below) */
  20. #define    ADD    1
  21. #define    SUB    2
  22. #define    MULT    3
  23. #define    DIV    4
  24. #define    AND    5
  25. #define    OR    6
  26. #define    GT    7
  27. #define    GE    8
  28. #define    EQ    9
  29. #define    NE    10
  30. #define    LT    11
  31. #define    LE    12
  32. /* unary op, precedence in NEG_PREC #define, below */
  33. #define    NEG    13
  34. /* symantically operands, ie, constants, variables and all functions */
  35. #define    CONST    14    
  36. #define    VAR    15
  37. #define    ABS    16    /* add functions if desired just like this is done */
  38. #define    SQRT    17    /* add functions if desired just like this is done */
  39. /* purely tokens - never get compiled as such */
  40. #define    LPAREN    255
  41. #define    RPAREN    254
  42. #define    ERR    (-1)
  43.  
  44. /* precedence of each of the binary operators.
  45.  * in case of a tie, compiler associates left-to-right.
  46.  * N.B. each entry's index must correspond to its #define!
  47.  */
  48. static int precedence[] = {0,5,5,6,6,2,1,4,4,3,3,4,4};
  49. #define    NEG_PREC    7    /* negation is highest */
  50.  
  51. /* execute-time operand stack */
  52. #define    MAX_STACK    16
  53. static double stack[MAX_STACK], *sp;
  54.  
  55. /* space for compiled opcodes - the "program".
  56.  * opcodes go in lower 8 bits.
  57.  * when an opcode has an operand (as CONST and VAR) it is really in opx[] and
  58.  *   the index is in the remaining upper bits.
  59.  */
  60. #define    MAX_PROG 32
  61. static int program[MAX_PROG], *pc;
  62. #define    OP_SHIFT    8
  63. #define    OP_MASK        0xff
  64.  
  65. /* auxiliary operand info.
  66.  * the operands (all but lower 8 bits) of CONST and VAR are really indeces
  67.  * into this array. thus, no point in making this any longer than you have
  68.  * bits more than 8 in your machine's int to index into it, ie, make
  69.  *    MAX_OPX <= 1 << ((sizeof(int)-1)*8)
  70.  * also, the fld's must refer to ones being flog'd, so not point in more
  71.  * of these then that might be used for plotting and srching combined.
  72.  */
  73. #define    MAX_OPX    16
  74. typedef union {
  75.     double opu_f;        /* value when opcode is CONST */
  76.     int opu_fld;        /* rcfpack() of field when opcode is VAR */
  77. } OpX;
  78. static OpX opx[MAX_OPX];
  79. static int opxidx;
  80.  
  81. /* these are global just for easy/rapid access */
  82. static int parens_nest;    /* to check that parens end up nested */
  83. static char *err_msg;    /* caller provides storage; we point at it with this */
  84. static char *cexpr, *lcexpr; /* pointers that move along caller's expression */
  85. static int good_prog;    /* != 0 when program appears to be good */
  86.  
  87. /* compile the given c-style expression.
  88.  * return 0 and set good_prog if ok,
  89.  * else return -1 and a reason message in errbuf.
  90.  */
  91. compile_expr (ex, errbuf)
  92. char *ex;
  93. char *errbuf;
  94. {
  95.     int instr;
  96.  
  97.     /* init the globals.
  98.      * also delete any flogs used in the previous program.
  99.      */
  100.     cexpr = ex;
  101.     err_msg = errbuf;
  102.     pc = program;
  103.     opxidx = 0;
  104.     parens_nest = 0;
  105.     do {
  106.         instr = *pc++;
  107.         if ((instr & OP_MASK) == VAR)
  108.         flog_delete (opx[instr >> OP_SHIFT].opu_fld);
  109.     } while (instr != HALT);
  110.  
  111.     pc = program;
  112.     if (compile(0) == ERR) {
  113.         (void) sprintf (err_msg + strlen(err_msg), " at \"%.10s\"", lcexpr);
  114.         good_prog = 0;
  115.         return (-1);
  116.     }
  117.     *pc++ = HALT;
  118.     good_prog = 1;
  119.     return (0);
  120. }
  121.  
  122. /* execute the expression previously compiled with compile_expr().
  123.  * return 0 with *vp set to the answer if ok, else return -1 with a reason
  124.  * why not message in errbuf.
  125.  */
  126. execute_expr (vp, errbuf)
  127. double *vp;
  128. char *errbuf;
  129. {
  130.     int s;
  131.  
  132.     err_msg = errbuf;
  133.     sp = stack + MAX_STACK;    /* grows towards lower addresses */
  134.     pc = program;
  135.     s = execute(vp);
  136.     if (s < 0)
  137.         good_prog = 0;
  138.     return (s);
  139. }
  140.  
  141. /* this is a way for the outside world to ask whether there is currently a
  142.  * reasonable program compiled and able to execute.
  143.  */
  144. prog_isgood()
  145. {
  146.     return (good_prog);
  147. }
  148.  
  149. /* get and return the opcode corresponding to the next token.
  150.  * leave with lcexpr pointing at the new token, cexpr just after it.
  151.  * also watch for mismatches parens and proper operator/operand alternation.
  152.  */
  153. static
  154. next_token ()
  155. {
  156.     static char toomt[] = "More than %d terms";
  157.     static char badop[] = "Illegal operator";
  158.     int tok = ERR;    /* just something illegal */
  159.     char c;
  160.  
  161.     while ((c = *cexpr) == ' ')
  162.         cexpr++;
  163.     lcexpr = cexpr++;
  164.  
  165.     /* mainly check for a binary operator */
  166.     switch (c) {
  167.     case '\0': --cexpr; tok = HALT; break; /* keep returning HALT */
  168.     case '+': tok = ADD; break; /* compiler knows when it's really unary */
  169.     case '-': tok = SUB; break; /* compiler knows when it's really negate */
  170.     case '*': tok = MULT; break;
  171.     case '/': tok = DIV; break;
  172.     case '(': parens_nest++; tok = LPAREN; break;
  173.     case ')':
  174.         if (--parens_nest < 0) {
  175.             (void) sprintf (err_msg, "Too many right parens");
  176.         return (ERR);
  177.         } else
  178.         tok = RPAREN;
  179.         break;
  180.     case '|':
  181.         if (*cexpr == '|') { cexpr++; tok = OR; }
  182.         else { (void) sprintf (err_msg, badop); return (ERR); }
  183.         break;
  184.     case '&':
  185.         if (*cexpr == '&') { cexpr++; tok = AND; }
  186.         else { (void) sprintf (err_msg, badop); return (ERR); }
  187.         break;
  188.     case '=':
  189.         if (*cexpr == '=') { cexpr++; tok = EQ; }
  190.         else { (void) sprintf (err_msg, badop); return (ERR); }
  191.         break;
  192.     case '!':
  193.         if (*cexpr == '=') { cexpr++; tok = NE; }
  194.         else { (void) sprintf (err_msg, badop); return (ERR); }
  195.         break;
  196.     case '<':
  197.         if (*cexpr == '=') { cexpr++; tok = LE; }
  198.         else tok = LT;
  199.         break;
  200.     case '>':
  201.         if (*cexpr == '=') { cexpr++; tok = GE; }
  202.         else tok = GT;
  203.         break;
  204.     }
  205.  
  206.     if (tok != ERR)
  207.         return (tok);
  208.  
  209.     /* not op so check for a constant, variable or function */
  210.     if (isdigit(c) || c == '.') {
  211.         if (opxidx > MAX_OPX) {
  212.         (void) sprintf (err_msg, toomt, MAX_OPX);
  213.         return (ERR);
  214.         }
  215.         opx[opxidx].opu_f = atof (lcexpr);
  216.         tok = CONST | (opxidx++ << OP_SHIFT);
  217.         skip_double();
  218.     } else if (isalpha(c)) {
  219.         /* check list of functions */
  220.         if (strncmp (lcexpr, "abs", 3) == 0) {
  221.         cexpr += 2;
  222.         tok = ABS;
  223.         } else if (strncmp (lcexpr, "sqrt", 4) == 0) {
  224.         cexpr += 3;
  225.         tok = SQRT;
  226.         } else {
  227.         /* not a function, so assume it's a variable */
  228.         int fld;
  229.         if (opxidx > MAX_OPX) {
  230.             (void) sprintf (err_msg, toomt, MAX_OPX);
  231.             return (ERR);
  232.         }
  233.         fld = parse_fieldname ();
  234.         if (fld < 0) {
  235.             (void) sprintf (err_msg, "Unknown field");
  236.             return (ERR);
  237.         } else {
  238.             if (flog_add (fld) < 0) { /* register with field logger */
  239.             (void) sprintf (err_msg, "Sorry; too many fields");
  240.             return (ERR);
  241.             }
  242.             opx[opxidx].opu_fld = fld;
  243.             tok = VAR | (opxidx++ << OP_SHIFT);
  244.         }
  245.         }
  246.     }
  247.  
  248.     return (tok);
  249. }
  250.  
  251. /* move cexpr on past a double.
  252.  * allow sci notation.
  253.  * no need to worry about a leading '-' or '+' but allow them after an 'e'.
  254.  * TODO: this handles all the desired cases, but also admits a bit too much
  255.  *   such as things like 1eee2...3. geeze; to skip a double right you almost
  256.  *   have to go ahead and crack it!
  257.  */
  258. static
  259. skip_double()
  260. {
  261.     int sawe = 0;    /* so we can allow '-' or '+' right after an 'e' */
  262.  
  263.     while (1) {
  264.         char c = *cexpr;
  265.         if (isdigit(c) || c=='.' || (sawe && (c=='-' || c=='+'))) {
  266.         sawe = 0;
  267.         cexpr++;
  268.         } else if (c == 'e') {
  269.         sawe = 1;
  270.         cexpr++;
  271.         } else
  272.         break;
  273.     }
  274. }
  275.  
  276. /* call this whenever you want to dig out the next (sub)expression.
  277.  * keep compiling instructions as long as the operators are higher precedence
  278.  * than prec, then return that "look-ahead" token that wasn't (higher prec).
  279.  * if error, fill in a message in err_msg[] and return ERR.
  280.  */
  281. static
  282. compile (prec)
  283. int prec;
  284. {
  285.     int expect_binop = 0;    /* set after we have seen any operand.
  286.                  * used by SUB so it can tell if it really 
  287.                  * should be taken to be a NEG instead.
  288.                  */
  289.     int tok = next_token ();
  290.  
  291.         while (1) {
  292.         int p;
  293.         if (tok == ERR)
  294.         return (ERR);
  295.         if (pc - program >= MAX_PROG) {
  296.         (void) sprintf (err_msg, "Program is too long");
  297.         return (ERR);
  298.         }
  299.  
  300.         /* check for special things like functions, constants and parens */
  301.             switch (tok & OP_MASK) {
  302.             case HALT: return (tok);
  303.         case ADD:
  304.         if (expect_binop)
  305.             break;    /* procede with binary addition */
  306.         /* just skip a unary positive(?) */
  307.         tok = next_token();
  308.         continue;
  309.         case SUB:
  310.         if (expect_binop)
  311.             break;    /* procede with binary subtract */
  312.         tok = compile (NEG_PREC);
  313.         *pc++ = NEG;
  314.         expect_binop = 1;
  315.         continue;
  316.             case ABS: /* other funcs would be handled the same too ... */
  317.         case SQRT:
  318.         /* eat up the function parenthesized argument */
  319.         if (next_token() != LPAREN || compile (0) != RPAREN) {
  320.             (void) sprintf (err_msg, "Function arglist error");
  321.             return (ERR);
  322.         }
  323.         /* then handled same as ... */
  324.             case CONST: /* handled same as... */
  325.         case VAR:
  326.         *pc++ = tok;
  327.         tok = next_token();
  328.         expect_binop = 1;
  329.         continue;
  330.             case LPAREN:
  331.         if (compile (0) != RPAREN) {
  332.             (void) sprintf (err_msg, "Unmatched left paren");
  333.             return (ERR);
  334.         }
  335.         tok = next_token();
  336.         expect_binop = 1;
  337.         continue;
  338.             case RPAREN:
  339.         return (RPAREN);
  340.             }
  341.  
  342.         /* everything else is a binary operator */
  343.         p = precedence[tok];
  344.             if (p > prec) {
  345.                 int newtok = compile (p);
  346.         if (newtok == ERR)
  347.             return (ERR);
  348.                 *pc++ = tok;
  349.         expect_binop = 1;
  350.                 tok = newtok;
  351.             } else
  352.                 return (tok);
  353.         }
  354. }
  355.  
  356. /* "run" the program[] compiled with compile().
  357.  * if ok, return 0 and the final result,
  358.  * else return -1 with a reason why not message in err_msg.
  359.  */
  360. static
  361. execute(result)
  362. double *result;
  363. {
  364.     int instr; 
  365.  
  366.     do {
  367.         instr = *pc++;
  368.         switch (instr & OP_MASK) {
  369.         /* put these in numberic order so hopefully even the dumbest
  370.          * compiler will choose to use a jump table, not a cascade of ifs.
  371.          */
  372.         case HALT: break;    /* outer loop will stop us */
  373.         case ADD:  sp[1] = sp[1] +  sp[0]; sp++; break;
  374.         case SUB:  sp[1] = sp[1] -  sp[0]; sp++; break;
  375.         case MULT: sp[1] = sp[1] *  sp[0]; sp++; break;
  376.         case DIV:  sp[1] = sp[1] /  sp[0]; sp++; break;
  377.         case AND:  sp[1] = sp[1] && sp[0] ? 1 : 0; sp++; break;
  378.         case OR:   sp[1] = sp[1] || sp[0] ? 1 : 0; sp++; break;
  379.         case GT:   sp[1] = sp[1] >  sp[0] ? 1 : 0; sp++; break;
  380.         case GE:   sp[1] = sp[1] >= sp[0] ? 1 : 0; sp++; break;
  381.         case EQ:   sp[1] = sp[1] == sp[0] ? 1 : 0; sp++; break;
  382.         case NE:   sp[1] = sp[1] != sp[0] ? 1 : 0; sp++; break;
  383.         case LT:   sp[1] = sp[1] <  sp[0] ? 1 : 0; sp++; break;
  384.         case LE:   sp[1] = sp[1] <= sp[0] ? 1 : 0; sp++; break;
  385.         case NEG:  *sp = -*sp; break;
  386.         case CONST: *--sp = opx[instr >> OP_SHIFT].opu_f; break;
  387.         case VAR:
  388.         if (flog_get(opx[instr>>OP_SHIFT].opu_fld, --sp, (char *)0)<0) {
  389.             (void) sprintf (err_msg, "Bug! VAR field not logged");
  390.             return (-1);
  391.         }
  392.         break;
  393.         case ABS:  *sp = fabs (*sp); break;
  394.         case SQRT: *sp = sqrt (*sp); break;
  395.         default:
  396.         (void) sprintf (err_msg, "Bug! bad opcode: 0x%x", instr);
  397.         return (-1);
  398.         }
  399.         if (sp < stack) {
  400.         (void) sprintf (err_msg, "Runtime stack overflow");
  401.         return (-1);
  402.         } else if (sp - stack > MAX_STACK) {
  403.         (void) sprintf (err_msg, "Bug! runtime stack underflow");
  404.         return (-1);
  405.         }
  406.     } while (instr != HALT);
  407.  
  408.     /* result should now be on top of stack */
  409.     if (sp != &stack[MAX_STACK - 1]) {
  410.         (void) sprintf (err_msg, "Bug! stack has %d items",
  411.                             MAX_STACK - (sp-stack));
  412.         return (-1);
  413.     }
  414.     *result = *sp;
  415.     return (0);
  416. }
  417.  
  418. /* starting with lcexpr pointing at a string expected to be a field name,
  419.  * return an rcfpack(r,c,0) of the field else -1 if bad.
  420.  * when return, leave lcexpr alone but move cexpr to just after the name.
  421.  */
  422. static
  423. parse_fieldname ()
  424. {
  425.     int r = -1, c = -1;     /* anything illegal */
  426.     char *fn = lcexpr;    /* likely faster than using the global */
  427.     char f0, f1;
  428.     char *dp;
  429.  
  430.     /* search for first thing not an alpha char.
  431.      * leave it in f0 and leave dp pointing to it.
  432.      */
  433.     dp = fn;
  434.     while (isalpha(f0 = *dp))
  435.         dp++;
  436.  
  437.     /* crack the new field name.
  438.      * when done trying, leave dp pointing at first char just after it.
  439.      * set r and c if we recognized it.
  440.      */
  441.     if (f0 == '.') {
  442.         int jcontext = 0;    /* need more of then as time goes on */
  443.  
  444.         /* object.column "dot" notation pair.
  445.          * crack the first portion (pointed to by fn): set r.
  446.          * then the second portion (pointed to by dp+1): set c.
  447.          */
  448.         f0 = fn[0];
  449.         f1 = fn[1];
  450.         switch (f0) {
  451.         case 'c':            r = R_CALLISTO;
  452.         break;
  453.         case 'e':            r = R_EUROPA;
  454.         break;
  455.         case 'g':            r = R_GANYMEDE;
  456.         break;
  457.         case 'i':            r = R_IO;
  458.         break;
  459.         case 'j':
  460.                     r = R_JUPITER;
  461.         jcontext = 1;
  462.         break;
  463.         case 'm':
  464.         if (f1 == 'a')      r = R_MARS;
  465.         else if (f1 == 'e') r = R_MERCURY;
  466.         else if (f1 == 'o') r = R_MOON;
  467.         break;
  468.         case 'n':            r = R_NEPTUNE;
  469.         break;
  470.         case 'p':            r = R_PLUTO;
  471.         break;
  472.         case 's':
  473.         if (f1 == 'a')      r = R_SATURN;
  474.         else if (f1 == 'u') r = R_SUN;
  475.         break;
  476.         case 'u':            r = R_URANUS;
  477.         break;
  478.         case 'x':            r = R_OBJX;
  479.         break;
  480.         case 'y':            r = R_OBJY;
  481.         break;
  482.         case 'v':            r = R_VENUS;
  483.         break;
  484.         }
  485.  
  486.         /* now crack the column (stuff after the dp) */
  487.         dp++;    /* point at good stuff just after the decimal pt */
  488.         f0 = dp[0];
  489.         f1 = dp[1];
  490.         switch (f0) {
  491.         case 'a':
  492.         if (f1 == 'l')        c = C_ALT;
  493.         else if (f1 == 'z')   c = C_AZ;
  494.         break;
  495.         case 'd':              c = C_DEC;
  496.         break;
  497.         case 'e':
  498.         if (f1 == 'd')        c = C_EDIST;
  499.         else if (f1 == 'l')   c = C_ELONG;
  500.         break;
  501.         case 'h':
  502.         if (f1 == 'l') {
  503.             if (dp[2] == 'a')              c = C_HLAT;
  504.             else if (dp[2] == 'o')         c = C_HLONG;
  505.         } else if (f1 == 'r' || f1 == 'u') c = C_TUP;
  506.         break;
  507.         case 'j':              c = C_JUPITER;
  508.         break;
  509.         case 'm':
  510.         if (f1 == 'a')        c = C_MARS;
  511.         else if (f1 == 'e')   c = C_MERCURY;
  512.         else if (f1 == 'o')   c = C_MOON;
  513.         break;
  514.         case 'n':              c = C_NEPTUNE;
  515.         break;
  516.         case 'p':
  517.         if (f1 == 'h')        c = C_PHASE;
  518.         else if (f1 == 'l')   c = C_PLUTO;
  519.         break;
  520.         case 'r':
  521.         if (f1 == 'a') {
  522.             if (dp[2] == 'z') c = C_RISEAZ;
  523.             else           c = C_RA;
  524.         } else if (f1 == 't') c = C_RISETM;
  525.         break;
  526.         case 's':
  527.         if (f1 == 'a') {
  528.             if (dp[2] == 'z') c = C_SETAZ;
  529.             else          c = C_SATURN;
  530.         } else if (f1 == 'd') c = C_SDIST;
  531.         else if (f1 == 'i')   c = C_SIZE;
  532.         else if (f1 == 't')   c = C_SETTM;
  533.         else if (f1 == 'u')   c = C_SUN;
  534.         break;
  535.         case 't':
  536.         if (f1 == 'a')        c = C_TRANSALT;
  537.         else if (f1 == 't')   c = C_TRANSTM;
  538.         break;
  539.         case 'u':              c = C_URANUS;
  540.         break;
  541.         case 'x':              c = jcontext ? C_OBJX : C_JMX;
  542.         break;
  543.         case 'y':              c = jcontext ? C_OBJY : C_JMY;
  544.         break;
  545.         case 'z':              c = C_JMZ;
  546.         break;
  547.         case 'v':
  548.         if (f1 == 'e')        c = C_VENUS;
  549.         else if (f1 == 'm')   c = C_MAG;
  550.         break;
  551.         }
  552.  
  553.         /* now skip dp on past the column stuff */
  554.         while (isalpha(*dp))
  555.         dp++;
  556.     } else {
  557.         /* no decimal point; some other field */
  558.         f0 = fn[0];
  559.         f1 = fn[1];
  560.         switch (f0) {
  561.         case 'd':
  562.         if (f1 == 'a')      r = R_DAWN, c = C_DAWNV;
  563.         else if (f1 == 'u') r = R_DUSK, c = C_DUSKV;
  564.         break;
  565.         case 'j':
  566.         if (f1 == 'I') {
  567.             if (fn[2] == 'I') r = R_JCML, c = C_JCMLSII;
  568.             else           r = R_JCML, c = C_JCMLSI;
  569.         }
  570.         break;
  571.         case 'n':
  572.         r = R_LON, c = C_LONV;
  573.         break;
  574.         }
  575.     }
  576.  
  577.     cexpr = dp;
  578.     if (r <= 0 || c <= 0) return (-1);
  579.     return (rcfpack (r, c, 0));
  580. }
  581.